perm filename PCALL2.SAI[PNT,HE]1 blob sn#463376 filedate 1979-08-06 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00003 00003	! eeditcall,redefinecall
C00008 ENDMK
C⊗;
ENTRY;
BEGIN "PCALL2"
COMMENT routines which are not available in AL;
DEFINE $PCALL2=TRUE,$ALTER_EGO=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;

! eeditcall,redefinecall;

INTERNAL PROCEDURE EEDITCALL;
	BEGIN
	RPTR(SYMBOL)EL;INTEGER OBTYPE;STRING FBODY;
	RPTR(SCALAR,VECTOR,TRANS,FRAME,ROT,MACRO) TEMP;
	STRING VAR;
	NOEXPAND ← TRUE;

	VAR←IDF_READ; 
	SEMICOL_READ;    
	EL←OLDSYM(VAR,OBTYPE);				! var must exist in $YMTAB;
	TEMP←SYMBOL:OBJECT[EL];

	IF OBTYPE = #MC
	   THEN BEGIN
		INTEGER BRCHAR;
		STRING OLD_STRING;
		OLD_STRING← "REDEFINE "&MACRO:HEAD[SYMBOL:OBJECT[EL]]
			&" = "&CVSYM(EL,EDIT_D)&";";
		SWAP(OLD_STRING);
		ASKUSER(OLD_STRING);
		ALINIT;
		END
	   ELSE ERROR("EEDIT: only valid for macros");
	NOEXPAND ← FALSE;

	END;


INTERNAL PROCEDURE REDEFINECALL;
   BEGIN RPTR(MACRO) MACPTR; STRING MACNAME; INTEGER DDLCOUNT; STRING BODY,NBODY;
	RPTR(SYMBOL)EL; RANY TEMP;
	INTEGER NPARAM; INTEGER OBTYPE;
	NPARAM←0;
	NOEXPAND ← TRUE;
	MACNAME←IDF_READ; 
	EL←OLDSYM(MACNAME,OBTYPE);	! macname must exist in $YMTAB;
	TEMP←SYMBOL:OBJECT[EL];

	IF OBTYPE≠#MC
		THEN ERROR("MACRO REDEFINITION: need macro name");
	DDLCOUNT ← 0;
	MACPTR ← SYMBOL:OBJECT[EL];

	GTOKEN;

	IF TOKEN≠"("
	   THEN BEGIN STOKEN←TRUE; MACRO:HEAD[MACPTR]←MACNAME; END
	   ELSE
	    BEGIN "parametered macro"
		RCLASS PLIST(STRING PARAM; RPTR(PLIST) NEXTP);
	    	RPTR(PLIST) TEMP,TEMP0;
		TEMP0←NULL_RECORD;
		DO
		BEGIN "get parameters"
		GTOKEN;
		IF #TOKEN ≠ UNDECLARED_TYPE THEN 
		    ERROR("MACRO DEFINITION: need undeclared token for argument");
		NPARAM←NPARAM+1;
		TEMP←NEW!RECORD(PLIST);
		PLIST:NEXTP[TEMP]←TEMP0;
		PLIST:PARAM[TEMP]←TOKEN;
		TEMP0←TEMP;
		GTOKEN;
		IF TOKEN≠")" AND TOKEN≠"," 
		    THEN ERROR("MACRO DEFINITION: Need comma here");
		END "get parameters" UNTIL TOKEN=")";

		BEGIN
		INTEGER I; STRING ARRAY S[1:NPARAM];
		STRING HEAD; HEAD←")";

		FOR I←NPARAM STEP -1 UNTIL 1 DO
			BEGIN
			HEAD←","&(S[I]←PLIST:PARAM[TEMP])&HEAD;
			TEMP←PLIST:NEXTP[TEMP];
			END;
		MEMORY[LOCATION(S)]↔MEMORY[LOCATION(MACRO:PRLIST[MACPTR])];
		MACRO:HEAD[MACPTR]←MACNAME&"("&HEAD[2 TO ∞];
		END;
		MACRO:NPARAM[MACPTR]←NPARAM;
	    END "parametered macro";
	WORD_READ("=");
	WORD_READ("⊂"); DDLCOUNT ← 1;
	BODY←"⊂";
	
	DO BEGIN
		INTEGER I;
		I←READTILL("⊂⊃");
		BODY←BODY&TOKEN&I;
		IF I="⊂"
		   THEN DDLCOUNT ← DDLCOUNT + 1
		   ELSE DDLCOUNT ← DDLCOUNT - 1;
	   END UNTIL DDLCOUNT=0;

	BODY←BODY[2 TO ∞-1];
	IF NPARAM>0 THEN
	BEGIN
	NBODY←NULL;
	WHILE BODY DO
		BEGIN "process the parameters"
		INTEGER I;
		INTEGER BRCHAR; STRING TTOKEN;
		NBODY←NBODY&SCAN(BODY,$LTTAB,BRCHAR);
		TTOKEN←SCAN(BODY,$NLTTAB,BRCHAR);
		FOR I←1 STEP 1 UNTIL NPARAM
		    DO	IF EQU(MACRO:PRLIST[MACPTR][I],TTOKEN) THEN DONE;
		IF I>NPARAM THEN
			NBODY←NBODY&TTOKEN
			ELSE NBODY←NBODY&DUMMY_DELIM&TTOKEN&DUMMY_DELIM;
		END "process the parameters";
	END ELSE NBODY←BODY;
	MACRO:BODY[MACPTR]←NBODY;
	SEMICOL_READ;
	NOEXPAND ← FALSE;
	$MCLST←NULL;
   END;

END "PCALL2"